home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / ddj0897.zip / DYN401.ZIP / class / array.d < prev    next >
Text File  |  1996-03-20  |  19KB  |  767 lines
  1.  
  2.  
  3.  
  4. /*                                      
  5.  *
  6.  *      Copyright (c) 1993-1996 Algorithms Corporation
  7.  *      3020 Liberty Hills Drive
  8.  *      Franklin, TN 37067
  9.  *
  10.  *      ALL RIGHTS RESERVED.
  11.  *
  12.  *      
  13.  *      
  14.  */
  15.  
  16.  
  17.  
  18.  
  19. #include <string.h>
  20. #include "memalloc.h"
  21.  
  22.  
  23. #include "array1.h"
  24. #include "array2.h"
  25.  
  26.  
  27.  
  28. defclass  Array  {
  29.     char        iType;
  30.     unsigned    iRank;
  31.     INDEX_TYPE    *iShape;
  32.     INDEX_TYPE    iNelm;
  33.     void        *iArray;
  34.     void        *iRmp;        /*  registered memory pointer  */
  35. };
  36.  
  37.  
  38. static    int    Index_origin = 0;
  39.  
  40. static    int _A_esize(int type);
  41. static    void print_val(object str,ivType *iv,char *fmt1,char *fmt2);
  42. static    void p_val_mat(object str,unsigned rank,unsigned *shape,char **val ,int size,char *fmt,unsigned *bit_indx,char *buf, int typ);
  43. static    objrtn print_nest(object s, ivType *iv);
  44. static    objrtn Dup(object self,int ntype,int dval,int deep);
  45. static    int convert(ivType *iv,ivType *iv2);
  46.  
  47.  
  48.  
  49. static    unsigned char    pow1[] = { 1, 2, 4, 8, 16, 32, 64, 128 };
  50. static    unsigned char    pow2[] = { ~1, ~2, ~4, ~8, ~16, ~32, ~64,
  51.                (unsigned char)~128 };
  52.  
  53. static    char    OOB[] = "Error: Out of bounds array index.\n";
  54.  
  55.  
  56. cmeth    gNew()
  57. {
  58.     return gShouldNotImplement(self, "gNew");
  59. }
  60.  
  61. cmeth    gNewArray(int type, int rank, va_list _rest_)  /*  same as the following method */
  62. {
  63.     int    i;
  64.     INDEX_TYPE    n;
  65.     object    array = gNew(super);
  66.     ivType    *iv = ivPtr(array);
  67.  
  68.     iType = type;
  69.     iRank = rank;
  70.     iShape = rank ? MTnalloc(INDEX_TYPE, rank, iShape) : (INDEX_TYPE *) NULL;
  71.     for (i=0, n=1 ; i < rank ; ++i)
  72.         n *= iShape[i] = GetArg(unsigned);
  73.     iNelm = n;
  74.     if (type == AT_OBJ)  {
  75.         iArray = n ? Tncalloc(char, (unsigned) SIZE(type, n)) : NULL;
  76.         iRmp = gRegisterMemory(Dynace, iArray, (long) SIZE(type, n));
  77.     }  else
  78.         iArray = n ? MTncalloc(char, (unsigned) SIZE(type, n), iArray) : NULL;
  79.     return array;
  80. }
  81.  
  82. /*  same as the previous method  */
  83.  
  84. private    cmeth    NewArray(int type, int rank, unsigned *idx)
  85. {
  86.     int    i;
  87.     INDEX_TYPE    n;
  88.     object    array = gNew(super);
  89.     ivType    *iv = ivPtr(array);
  90.  
  91.     iType = type;
  92.     iRank = rank;
  93.     iShape = rank ? MTnalloc(INDEX_TYPE, rank, iShape) : (INDEX_TYPE *) NULL;
  94.     for (i=0, n=1 ; i < rank ; ++i)
  95.         n *= iShape[i] = idx[i];
  96.     iNelm = n;
  97.     if (type == AT_OBJ)  {
  98.         iArray = n ? Tncalloc(char, (unsigned) SIZE(type, n)) : NULL;
  99.         iRmp = gRegisterMemory(Dynace, iArray, (long) SIZE(type, n));
  100.     }  else
  101.         iArray = n ? MTncalloc(char, (unsigned) SIZE(type, n), iArray) : NULL;
  102.     return array;
  103. }
  104.  
  105. imeth    object    gDispose, gGCDispose ()
  106. {
  107.     if (iShape)
  108.         MA_free(iShape);
  109.     if (iArray)
  110.         if (iType == AT_OBJ)
  111.             free(iArray);
  112.         else
  113.             MA_free(iArray);
  114.     if (iRmp)
  115.         gRemoveRegisteredMemory(Dynace, iRmp);
  116.     gDispose(super);
  117.     return NULL;
  118. }
  119.  
  120. imeth    object    gDeepDispose()
  121. {
  122.     object    *v;
  123.     INDEX_TYPE    i;
  124.  
  125.     if (iType == AT_OBJ)  {
  126.         v = (object *) iArray;
  127.         for (i=0 ; i != iNelm ; ++i)
  128.             if (v[i])  {
  129.                 gDeepDispose(v[i]);
  130.                 v[i] = NULL;
  131.             }
  132.     }
  133.  
  134.     if (iShape)
  135.         MA_free(iShape);
  136.     if (iArray)
  137.         if (iType == AT_OBJ)
  138.             free(iArray);
  139.         else
  140.             MA_free(iArray);
  141.     if (iRmp)
  142.         gRemoveRegisteredMemory(Dynace, iRmp);
  143.     gDispose(super);
  144.     return NULL;
  145. }
  146.  
  147. imeth    void    *gArrayPointer()
  148. {
  149.     return iArray;
  150. }
  151.  
  152. imeth    unsigned  gRank()
  153. {
  154.     return iRank;
  155. }
  156.  
  157. imeth    gShape()
  158. {
  159.     unsigned  i;
  160.     object    r;
  161.     ivType    *iv2;
  162.  
  163.     r = vNew(ShortArray, 1, iRank);
  164.     iv2 = ivPtr(r);
  165.  
  166.     for (i=0 ; i < iRank ; ++i)
  167.         ((INDEX_TYPE *) iv2->iArray)[i] = iShape[i];
  168.  
  169.     return r;
  170. }
  171.  
  172. imeth    void    *gIndex(va_list _rest_)
  173. {
  174.     INDEX_TYPE    offset, r, i;
  175.  
  176.     if (iType == AT_BIT)
  177.         gError(self, "Cannot use gIndex on BitArray\n");
  178.     if (!iRank)
  179.         return iArray;    /* scalor    */
  180.     r = iRank - 1;
  181.     for (i=0, offset=(INDEX_TYPE) 0 ; i <= r ; ++i)  {
  182.         INDEX_TYPE    m, n, j;
  183.         
  184.         n = GetArg(unsigned) - Index_origin;
  185.         if (n >= iShape[i])        /*  Index out of bounds  */
  186.             gError(self, OOB);
  187.         for (m=1, j=r ; j != i ; )
  188.             m *= iShape[j--];
  189.         if (!m)        /* 0 Diminsion size      */
  190.             gError(self, OOB);
  191.         offset += m * n;
  192.     }
  193.     return (void *) ((char *) iArray + _A_esize(iType) * offset);
  194. }
  195.  
  196. ivmeth    int    vBitValue(...)
  197. {
  198.     int        i, r;
  199.     INDEX_TYPE    offset;
  200.     MAKE_REST(self);
  201.  
  202.     if (iType != AT_BIT)
  203.         gError(self, "Error: Can't use vBitValue on non-BitArrays\n");
  204.     r = iRank - 1;
  205.     for (i=0, offset=(INDEX_TYPE) 0 ; i <= r ; ++i)  {
  206.         INDEX_TYPE    m;
  207.         INDEX_TYPE    n;
  208.         register int    j;
  209.         
  210.         n = GetArg(INDEX_TYPE) - Index_origin;
  211.         if (n >= iShape[i])    /*  Index out of bounds  */
  212.             gError(self, OOB);
  213.         for (m=1, j=r ; j != i ; )
  214.             m *= iShape[j--];
  215.         if (!m)        /* 0 Diminsion size      */
  216.             gError(self, OOB);
  217.         offset += m * n;
  218.     }
  219.     return !!BIT_VAL(iArray, offset);
  220. }
  221.  
  222. ivmeth    vChangeBitValue(int v, ...)
  223. {
  224.     int        i, r;
  225.     INDEX_TYPE    offset;
  226.     MAKE_REST(v);
  227.  
  228.     if (iType != AT_BIT)
  229.         gError(self, "Error: Can't use vChangeBitValue on non-BitArrays\n");
  230.     r = iRank - 1;
  231.     for (i=0, offset=(INDEX_TYPE) 0 ; i <= r ; ++i)  {
  232.         INDEX_TYPE    m;
  233.         INDEX_TYPE    n;
  234.         register int    j;
  235.         
  236.         n = GetArg(INDEX_TYPE) - Index_origin;
  237.         if (n >= iShape[i])        /*  Index out of bounds  */
  238.             gError(self, OOB);
  239.         for (m=1, j=r ; j != i ; )
  240.             m *= iShape[j--];
  241.         if (!m)        /* 0 Diminsion size      */
  242.             gError(self, OOB);
  243.         offset += m * n;
  244.     }
  245.     SET_BIT(iArray, offset, v);
  246.     return self;
  247. }
  248.  
  249. cmeth    gIota(int n)
  250. {
  251.     INDEX_TYPE    c;
  252.     int    i;
  253.     object    a;
  254.     ivType    *iv;
  255.     
  256.     USE(self);
  257.     a = vNew(ShortArray, 1, n);
  258.     iv = ivPtr(a);
  259.     for (c=Index_origin, i=0 ; i < n ; )
  260.         ((short *) iArray)[i++] = c++;
  261.     return a;
  262. }
  263.  
  264. ivmeth    object    vReshape(unsigned rank, ...)
  265. {
  266.     INDEX_TYPE    n, *shape, d, i;
  267.     MAKE_REST(rank);
  268.  
  269.     shape = rank ? MTnalloc(INDEX_TYPE, rank, iShape) : (INDEX_TYPE *) NULL;
  270.     for (i=0, n=1 ; i < rank ; ++i)  {
  271.         d = GetArg(INDEX_TYPE);
  272.         n *= d;
  273.         shape[i] = d;
  274.     }
  275.  
  276.     if (iNelm != n)  {
  277.         char        *fp, *tp;
  278.         void        *array;
  279.         INDEX_TYPE    s1, s2, s1org;
  280.  
  281.         s1org = s1 = SIZE(iType, iNelm);
  282.         s2 = SIZE(iType, n);
  283.         if (iType == AT_OBJ)
  284.             array = n ? Tncalloc(char, s2) : NULL;
  285.         else
  286.             array = n ? MTncalloc(char, s2, iArray) : NULL;
  287.  
  288.         fp = (char *) iArray;
  289.         tp = (char *) array;
  290.         while (s2)  {
  291.             unsigned    m;
  292.  
  293.             m = s2 < s1 ? s2 : s1;
  294.             memcpy(tp, fp, m);
  295.             s2 -= m;
  296.             s1 -= m;
  297.             if (!s1)  {
  298.                 fp = (char *) iArray;
  299.                 s1 = s1org;
  300.             } else
  301.                 fp += m;
  302.             tp += m;
  303.         }
  304.         if (iArray)
  305.             if (iType == AT_OBJ)
  306.                 free(iArray);
  307.             else
  308.                 MA_free(iArray);
  309.         iArray = array;
  310.  
  311.         iNelm = n;
  312.         if (iType == AT_OBJ)  {
  313.             void    *rmp = gRegisterMemory(Dynace, iArray, (long) SIZE(iType, iNelm));
  314.             gRemoveRegisteredMemory(Dynace, iRmp);
  315.             iRmp = rmp;
  316.         }
  317.     }
  318.     iRank = rank;
  319.     if (iShape)
  320.         MA_free(iShape);
  321.     iShape = shape;
  322.     
  323.     return self;
  324. }
  325.  
  326. /* returns the size of individual elements  */
  327.  
  328. static    int    _A_esize(int type)
  329. {
  330.     switch (type)  {
  331.         case AT_CHAR:        return sizeof(char);
  332.         case AT_SHRT:        return sizeof(short);
  333.         case AT_USHT:        return sizeof(_ushort);
  334.         case AT_INT:        return sizeof(int);
  335.         case AT_LONG:        return sizeof(long);
  336.         case AT_FLOT:        return sizeof(float);
  337.         case AT_DBLE:        return sizeof(double);
  338.         case AT_OBJ:        return sizeof(object);
  339.         case AT_BIT:        return 0;
  340.         case AT_PNTR:        return sizeof(char *);
  341.         default:        return 0;
  342.     }
  343. }
  344.  
  345. imeth    int    gSize()
  346. {
  347.     return iNelm;
  348. }
  349.  
  350. imeth    int    gEqual(obj)
  351. {
  352.     ivType    *iv2;
  353.     unsigned    i;
  354.     
  355.     ChkArg(obj, 2);
  356.     if (!gIsKindOf(obj, CLASS))
  357.         return 0;
  358.     iv2 = ivPtr(obj);
  359.     if (iType != iv2->iType  ||  iRank != iv2->iRank  ||  iNelm != iv2->iNelm)
  360.         return 0;
  361.     for (i=0 ; i < iRank ; ++i)
  362.         if (iShape[i] != iv2->iShape[i])
  363.             return 0;
  364.     return iArray ? !memcmp(iArray, iv2->iArray, (int) SIZE(iType, iNelm)) : 1;
  365. }
  366.  
  367. imeth    gStringRepValue()
  368. {
  369.     object    s;
  370.  
  371.     s = gNew(String);
  372.     switch (iType)  {
  373.         case AT_CHAR:    print_val(s, iv, "%c", "%c");        break;
  374.         case AT_SHRT:    print_val(s, iv, "%hd ", "%6hd ");    break;
  375.         case AT_USHT:    print_val(s, iv, "%hu ", "%5hu ");    break;
  376.         case AT_INT:    print_val(s, iv, "%d ", "%6d ");    break;
  377.         case AT_LONG:    print_val(s, iv, "%ld ", "%10ld ");    break;
  378.         case AT_FLOT:    print_val(s, iv, "%hf ", "%10.2hf ");    break;
  379.         case AT_DBLE:    print_val(s, iv, "%lf ", "%10.2lf ");    break;
  380.         case AT_OBJ:    print_nest(s, iv);            break;
  381.         case AT_BIT:    print_val(s, iv, "%d ", "%1d ");    break;
  382.         case AT_PNTR:    print_val(s, iv, "%lx ", "%8lx ");    break;
  383.     }
  384.     return s;
  385. }
  386.  
  387. imeth    gStringRep()
  388. {
  389.     char    *t, buf[60];
  390.     object    s;
  391.  
  392.     switch (iType)  {
  393.         case AT_CHAR:    t = "Character";    break;
  394.         case AT_SHRT:    t = "Short";        break;
  395.         case AT_USHT:    t = "Unsigned Short";    break;
  396.         case AT_INT:    t = "Integer";        break;
  397.         case AT_LONG:    t = "Long";        break;
  398.         case AT_FLOT:    t = "Float";        break;
  399.         case AT_DBLE:    t = "Double";        break;
  400.         case AT_OBJ:    t = "Object Array";    break;
  401.         case AT_BIT:    t = "Bit";        break;
  402.         case AT_PNTR:    t = "Pointer";        break;
  403.         default:    t = "Unknown";        break;
  404.     }
  405.     s = vSprintf(String, "Type  = %s\n", t);
  406.     sprintf(buf, "Rank  = %d\n", (int) iRank);
  407.     gAppend(s, (object) buf);
  408.     
  409.     if (iRank)  {
  410.         unsigned    i;
  411.  
  412.         gAppend(s, (object) "Shape = ");
  413.         for (i=0 ; i < iRank ; )  {
  414.             sprintf(buf, PRNT_SHAPE, iShape[i++]);
  415.             gAppend(s, (object) buf);
  416.         }
  417.         gAppend(s, (object) "\n");
  418.     }
  419.     gAppend(s, (object) "Value = ");
  420.     switch (iType)  {
  421.         case AT_CHAR:    print_val(s, iv, "%c", "%c");        break;
  422.         case AT_SHRT:    print_val(s, iv, "%hd ", "%6hd ");    break;
  423.         case AT_USHT:    print_val(s, iv, "%hu ", "%5hu ");    break;
  424.         case AT_INT:    print_val(s, iv, "%d ", "%6d ");    break;
  425.         case AT_LONG:    print_val(s, iv, "%ld ", "%10ld ");    break;
  426.         case AT_FLOT:    print_val(s, iv, "%hf ", "%10.2hf ");    break;
  427.         case AT_DBLE:    print_val(s, iv, "%lf ", "%10.2lf ");    break;
  428.         case AT_OBJ:    print_nest(s, iv);            break;
  429.         case AT_BIT:    print_val(s, iv, "%d ", "%1d ");    break;
  430.         case AT_PNTR:    print_val(s, iv, "%lx ", "%8lx ");    break;
  431.     }
  432.     return s;
  433. }
  434.  
  435. static    void    _fmt(char *buf, char *fmt, void *var, int typ)
  436. {
  437.     switch (typ)  {
  438.     case AT_CHAR:    sprintf(buf, fmt, *((char *) var));    break;
  439.     case AT_SHRT:    sprintf(buf, fmt, *((short *) var));    break;
  440.     case AT_USHT:    sprintf(buf, fmt, *((_ushort *) var));    break;
  441.     case AT_INT:    sprintf(buf, fmt, *((int *) var));    break;
  442.     case AT_LONG:    sprintf(buf, fmt, *((long *) var));    break;
  443.     case AT_FLOT:    sprintf(buf, fmt, *((float *) var));    break;
  444.     case AT_DBLE:    sprintf(buf, fmt, *((double *) var));    break;
  445.     case AT_OBJ:    sprintf(buf, fmt, *((object *) var));    break;
  446.     case AT_PNTR:    sprintf(buf, fmt, *((void **) var));    break;
  447.     }
  448. }
  449.  
  450. static    void    print_val(object str, ivType *iv, char *fmt1, char *fmt2)
  451. {
  452.     INDEX_TYPE    i, bit_indx = 0;
  453.     int    s = _A_esize(iType);
  454.     char    buf[60], *val;
  455.     
  456.     switch (iRank)  {
  457.         case 0:    if (iType != AT_BIT)  {
  458.                 _fmt(buf, fmt1, iArray, iType);
  459.                 if (iType == AT_CHAR)
  460.                     vBuild(str, NULL, "\"", buf, "\"\n", NULL);
  461.                 else
  462.                     vBuild(str, NULL, buf, "\n", NULL);
  463.             }  else  {
  464.                 sprintf(buf, fmt1, !!BIT_VAL(iArray, 0));
  465.                 vBuild(str, NULL, buf, "\n", NULL);
  466.             }
  467.             break;
  468.         case 1:    if (iType != AT_BIT)  {
  469.                 if (iType == AT_CHAR)
  470.                     gAppend(str, (object) "\"");
  471.                 val = (char *) iArray;
  472.                 for (i=0 ; i++ != *iShape ; val+=s)  {
  473.                     _fmt(buf, fmt1, val, iType);
  474.                     gAppend(str, (object) buf);
  475.                 }
  476.                 if (iType == AT_CHAR)
  477.                     gAppend(str, (object) "\"");
  478.             }  else
  479.                 for (i=0 ; i != *iShape ; ++i)  {
  480.                     sprintf(buf, fmt1, !!BIT_VAL(val, i));
  481.                     gAppend(str, (object) buf);
  482.                 }
  483.             gAppend(str, (object) "\n");
  484.             break;
  485.         default:gAppend(str, (object) "\n\n");
  486.             val = (char *) iArray;
  487.             p_val_mat(str, iRank, iShape, &val, s, fmt2, &bit_indx, buf, iType);
  488.     }
  489. }
  490.  
  491. static    void    p_val_mat(object str, unsigned rank, INDEX_TYPE *shape, char **val, int size, char *fmt, INDEX_TYPE *bit_indx, char *buf, int type)
  492. {
  493.     INDEX_TYPE    r, c;
  494.  
  495.     if (rank == 2)
  496.         if (size)    /*  not a bit field  */
  497.             for (r=0 ; r++ != *shape ; )  {
  498.                 for (c=0 ; c++ != shape[1] ; (*val)+=size)  {
  499.                     _fmt(buf, fmt, *val, type);
  500.                     gAppend(str, (object) buf);
  501.                 }
  502.                 gAppend(str, (object) "\n");
  503.             }
  504.         else
  505.             for (r=0 ; r++ != *shape ; )  {
  506.                 for (c=0 ; c++ != shape[1] ; (*bit_indx)++)  {
  507.                     sprintf(buf, fmt, !!BIT_VAL(*val, *bit_indx));
  508.                     gAppend(str, (object) buf);
  509.                 }
  510.                 gAppend(str, (object) "\n");
  511.             }
  512.     else  
  513.         for (r=0 ; r++ != *shape ; )  {
  514.             p_val_mat(str, rank-1, shape+1, val, size, fmt, bit_indx, buf, type);
  515.             gAppend(str, (object) "\n");
  516.         }
  517. }
  518.  
  519. static    objrtn    print_nest(object s, ivType *iv)
  520. {
  521.     INDEX_TYPE    i;
  522.     object    *val = (object *) iArray;
  523.     object    t;
  524.  
  525.     for (i=0 ; i++ != iNelm ; )  {
  526.         if (t = *val++)  {
  527.             t = gStringRepValue(*val++);
  528.             vBuild(s, NULL, "\n", t, "\n", NULL);
  529.             gDispose(t);
  530.         } else
  531.             gAppend(s, (object) "NULL\n");
  532.     }
  533.     return s;
  534. }
  535.  
  536. /*  duplicate an array and optionally change the type    */
  537.  
  538. private    imeth    Dup(object self, int ntype, int dval, int deep)
  539.                        /*  array to be duplicated    */
  540.                      /*  new array data type        */
  541.                     /*  duplicate value flag    */
  542. {
  543.     register unsigned    i;
  544.     object    narray, cls;
  545.     ivType    *iv2;
  546.     
  547.     if (!ntype)
  548.         ntype = iType;
  549.     if (ntype != iType  &&  (
  550.                 ntype == AT_OBJ  ||  ntype == AT_PNTR  ||
  551.                 iType == AT_OBJ  ||   iType == AT_PNTR))
  552.         gError(self, "Error:  Can't convert array to requested type.\n");
  553.  
  554.     switch (ntype)  {
  555.     case AT_CHAR:    cls = CharacterArray;        break;
  556.     case AT_SHRT:    cls = ShortArray;        break;
  557.     case AT_USHT:    cls = UnsignedShortArray;    break;
  558.     case AT_INT:    cls = IntegerArray;        break;
  559.     case AT_LONG:    cls = LongArray;        break;
  560.     case AT_FLOT:    cls = FloatArray;        break;
  561.     case AT_DBLE:    cls = DoubleFloatArray;        break;
  562.     case AT_BIT:    cls = BitArray;            break;
  563.     case AT_OBJ:    cls = ObjectArray;        break;
  564.     case AT_PNTR:    cls = PointerArray;        break;
  565.     default:    cls = NULL;            break;
  566.     }
  567.     narray = NewArray(cls, ntype, iRank, iShape);
  568.     iv2 = ivPtr(narray);
  569.  
  570.     if (dval)
  571.         if (ntype == iType)
  572.             if (iType == AT_OBJ  &&  deep)  {
  573.                 object    *fv = (object *) iArray;
  574.                 object    *tv = (object *) iv2->iArray;
  575.                 for (i=0 ; i != iNelm ; ++i)
  576.                     if (fv[i])
  577.                         tv[i] = gDeepCopy(fv[i]);
  578.             }  else
  579.                 memcpy(iv2->iArray, iArray, (int) SIZE(iType, iNelm));
  580.         else
  581.             convert(iv, iv2);
  582.     return narray;
  583. }
  584.  
  585. #define Ftod(x)    (double)(x)
  586. #define Dtol(x)    (long)(x)
  587.  
  588. #if 0
  589. #define CONV(tt, ft)    while (n--) *((tt *) nval)++ = (tt) *((ft *) val)++
  590. #define CONVFI(tt, ft)    while (n--) *((tt *) nval)++ = (tt) Dtol((double)*((ft *) val)++)
  591. #define CONVFD()    while (n--) *((double *) nval)++ = Ftod(*((float *) val)++)
  592. #define CONVFB(tt)    while (n--) *((tt *) nval)++ = (tt) !!BIT_VAL(val, n)
  593. #define CONVTB(ft)   for (m=0 ; m != n ; m++) SET_BIT(nval, m, *((ft *) val)++)
  594. #else
  595. #define CONV(tt, ft)        \
  596.     while (n--)  {        \
  597.             *((tt *) nval) = (tt) *((ft *) val);            \
  598.         nval = (void *) (1 + (tt *) nval);            \
  599.         val  = (void *) (1 + (ft *) val);            \
  600.     }
  601. #define CONVFI(tt, ft)        \
  602.     while (n--)  {        \
  603.         *((tt *) nval) = (tt) Dtol((double)*(ft *) val);    \
  604.         nval = (void *) (1 + (tt *) nval);            \
  605.         val  = (void *) (1 + (ft *) val);            \
  606.     }
  607. #define CONVFD()        \
  608.     while (n--)  {        \
  609.         *((double *) nval) = Ftod(*((float *) val));        \
  610.         nval = (void *) (1 + (double *) nval);            \
  611.         val  = (void *) (1 + (float *) val);            \
  612.     }
  613. #define CONVFB(tt)        \
  614.     while (n--)  {        \
  615.         *((tt *) nval) = (tt) !!BIT_VAL(val, n);        \
  616.         nval = (void *) (1 + (tt *) nval);            \
  617.     }
  618. #define CONVTB(ft)           \
  619.     for (m=0 ; m != n ; m++)  {                    \
  620.         SET_BIT(nval, m, *((ft *) val));            \
  621.         val  = (void *) (1 + (ft *) val);            \
  622.     }
  623. #endif
  624.  
  625. static    int    convert(ivType *iv, ivType *iv2)
  626. {
  627.     INDEX_TYPE    m;
  628.     INDEX_TYPE    n = iNelm;
  629.     void    *val = iArray;
  630.     void    *nval = iv2->iArray;
  631.  
  632.     switch (iv2->iType)  {
  633.     case AT_CHAR:
  634.         switch (iType)  {
  635.         case AT_SHRT:    CONV(char, short);        break;
  636.         case AT_USHT:    CONV(char, _ushort);        break;
  637.         case AT_INT:    CONV(char, int);        break;
  638.         case AT_LONG:    CONV(char, long);        break;
  639.         case AT_FLOT:    CONVFI(char, float);        break;
  640.         case AT_DBLE:    CONVFI(char, double);        break;
  641.         case AT_BIT:    CONVFB(char);            break;
  642.         default:    return(1);            break;
  643.         }
  644.         break;
  645.     case AT_SHRT:
  646.         switch (iType)  {
  647.         case AT_CHAR:    CONV(short, char);        break;
  648.         case AT_USHT:    CONV(short, _ushort);        break;
  649.         case AT_INT:    CONV(short, int);        break;
  650.         case AT_LONG:    CONV(short, long);        break;
  651.         case AT_FLOT:    CONVFI(short, float);        break;
  652.         case AT_DBLE:    CONVFI(short, double);        break;
  653.         case AT_BIT:    CONVFB(short);            break;
  654.         default:    return(1);            break;
  655.         }
  656.         break;
  657.     case AT_USHT:
  658.         switch (iType)  {
  659.         case AT_CHAR:    CONV(_ushort, char);        break;
  660.         case AT_SHRT:    CONV(_ushort, short);        break;
  661.         case AT_INT:    CONV(_ushort, int);        break;
  662.         case AT_LONG:    CONV(_ushort, long);        break;
  663.         case AT_FLOT:    CONVFI(_ushort, float);        break;
  664.         case AT_DBLE:    CONVFI(_ushort, double);    break;
  665.         case AT_BIT:    CONVFB(_ushort);        break;
  666.         default:    return(1);            break;
  667.         }
  668.         break;
  669.     case AT_INT:
  670.         switch (iType)  {
  671.         case AT_CHAR:    CONV(int, char);        break;
  672.         case AT_SHRT:    CONV(int, short);        break;
  673.         case AT_USHT:    CONV(int, _ushort);        break;
  674.         case AT_LONG:    CONV(int, long);        break;
  675.         case AT_FLOT:    CONVFI(int, float);        break;
  676.         case AT_DBLE:    CONVFI(int, double);        break;
  677.         case AT_BIT:    CONVFB(int);            break;
  678.         default:    return(1);            break;
  679.         }
  680.         break;
  681.     case AT_LONG:
  682.         switch (iType)  {
  683.         case AT_CHAR:    CONV(long, char);        break;
  684.         case AT_SHRT:    CONV(long, short);        break;
  685.         case AT_USHT:    CONV(long, _ushort);        break;
  686.         case AT_INT:    CONV(long, int);        break;
  687.         case AT_FLOT:    CONVFI(long, float);        break;
  688.         case AT_DBLE:    CONVFI(long, double);        break;
  689.         case AT_BIT:    CONVFB(long);            break;
  690.         default:    return(1);            break;
  691.         }
  692.         break;
  693.     case AT_FLOT:
  694.         switch (iType)  {
  695.         case AT_CHAR:    CONV(float, char);        break;
  696.         case AT_SHRT:    CONV(float, short);        break;
  697.         case AT_USHT:    CONV(float, _ushort);        break;
  698.         case AT_INT:    CONV(float, int);        break;
  699.         case AT_LONG:    CONV(float, long);        break;
  700.         case AT_DBLE:    CONV(float, double);        break;
  701.         case AT_BIT:    CONVFB(float);            break;
  702.         default:    return(1);            break;
  703.         }
  704.         break;
  705.     case AT_DBLE:
  706.         switch (iType)  {
  707.         case AT_CHAR:    CONV(double, char);        break;
  708.         case AT_SHRT:    CONV(double, short);        break;
  709.         case AT_USHT:    CONV(double, _ushort);        break;
  710.         case AT_INT:    CONV(double, int);        break;
  711.         case AT_LONG:    CONV(double, long);        break;
  712.         case AT_FLOT:    CONVFD();            break;
  713.         case AT_BIT:    CONVFB(double);            break;
  714.         default:    return(1);            break;
  715.         }
  716.         break;
  717.     case AT_BIT:
  718.         switch (iType)  {
  719.         case AT_CHAR:    CONVTB(char);            break;
  720.         case AT_SHRT:    CONVTB(short);            break;
  721.         case AT_USHT:    CONVTB(_ushort);        break;
  722.         case AT_INT:    CONVTB(int);            break;
  723.         case AT_LONG:    CONVTB(long);            break;
  724.         case AT_FLOT:    CONVTB(float);            break;
  725.         case AT_DBLE:    CONVTB(double);            break;
  726.         default:    return(1);            break;
  727.         }
  728.         break;
  729.     default:    return(1);        break;
  730.     }
  731.     return(0);
  732. }
  733.  
  734. imeth    gCopy()
  735. {
  736.     return Dup(self, 0, 1, 0);
  737. }
  738.  
  739. imeth    gDeepCopy()
  740. {
  741.     return Dup(self, 0, 1, 1);
  742. }
  743.  
  744. cmeth    gIndexOrigin(int n)
  745. {
  746.     Index_origin = n;
  747.     return self;
  748. }
  749.  
  750.  
  751.  
  752.  
  753. /*                                      
  754.  *
  755.  *      Copyright (c) 1993-1996 Algorithms Corporation
  756.  *      3020 Liberty Hills Drive
  757.  *      Franklin, TN 37067
  758.  *
  759.  *      ALL RIGHTS RESERVED.
  760.  *
  761.  *      
  762.  *      
  763.  */
  764.  
  765.  
  766.  
  767.